Define functions, directories, color palettes, inputs, etc here.
library(sf)
library(measurements)
library(tidycensus)
library(tidyverse)
library(tmap)
proj <- 2246 # https://www.spatialreference.org/ref/epsg/2246/
paletteY <- c("#F9F871","#FFD364","#FFAF6D","#FF8F80","#F87895", "D16BA5")
palette5 <- c("#25CB10", "#5AB60C", "#8FA108","#C48C04", "#FA7800")
rebalance_file <- paste(data_directory,
"/Louisville-MDS-Status-Changes-2019Dec17.csv",
sep = "")
rebalance_data <- read_csv(rebalance_file)
base_map <- st_read("https://opendata.arcgis.com/datasets/6e3dea8bd9cf49e6a764f7baa9141a95_30.geojson")
base_map_proj <- base_map %>% st_transform(proj)
boundary <- st_union(base_map_proj) %>% st_sf()
cell_area <- conv_unit(0.5, from = "mi2", to = "ft2")
cell_size <- (cell_area * (2/3^0.5)) ^ 0.5 # the "cellsize" parameter is the distance between the centroids of each hexagonal cell.
lville_fishnet <- st_make_grid(boundary, cellsize = cell_size, square = FALSE) %>%
st_sf() %>%
mutate(fishnet_ID = row_number())
activity_distro_plot <- rebalance_data %>%
ggplot(aes(x = reason)) +
geom_bar(stat = "count", position = "identity") +
facet_wrap(~ type, scales = "free") +
coord_flip() +
labs(x = "Reason for Status Change",
y = "Count",
title = "Distribution of Scooter Status Change Activities")
activity_distro_plot
rebalance_data_sf <- st_as_sf(rebalance_data,
wkt = "location",
crs = 4326)
rebalance_data_sf_proj <- rebalance_data_sf %>%
st_transform(proj)
rebalance_only <- rebalance_data_sf_proj %>%
filter(str_detect(reason, "rebalance"))
rebalance_only <- rebalance_only[base_map_proj,] #intersect data
Scooters tend to be rebalanced from all over Louisville to the waterfront and Old Louisville.
ggplot() +
geom_sf(data = base_map_proj, fill = NA, color = "lightgray") +
geom_sf(data = rebalance_only,
aes(color = reason),
alpha = 0.1) +
facet_wrap(~ reason) +
theme_minimal()
rebalance_pickups <- rebalance_only %>%
dplyr::select(reason) %>%
filter(reason == "rebalance pick up")
rebalance_dropoffs <- rebalance_only %>%
dplyr::select(reason) %>%
filter(reason == "rebalance drop off")
Interactive map
tmap_mode("view")
tm_shape(rebalance_pickups %>% sample_n(10000)) +
tm_dots(col = "red",
alpha = 0.2)
tm_shape(rebalance_dropoffs %>% sample_n(10000)) +
tm_dots(col = "blue",
alpha = 0.2)
lville_fishnet2 <- lville_fishnet %>%
mutate(pickups = lengths(st_intersects(., rebalance_pickups)),
dropoffs = lengths(st_intersects(., rebalance_dropoffs))) %>%
gather(key = "Event", value = "Count", pickups:dropoffs)
ggplot() +
# geom_sf(data = base_map_proj, fill = NA, color = "lightgray") +
geom_sf(data = lville_fishnet2,
aes(fill = log(Count + 1)),
alpha = 1) +
scale_fill_continuous(high = "#132B43", low = "#56B1F7") +
facet_wrap(~ Event) +
theme_minimal() +
labs(subtitle = "Note these are log-transformed")